unit uConfig;
(*

  Configuration manager for eConsole

*)
interface

Uses Classes,
     Graphics,
     SysUtils,
     INIFiles
     ;

Type CConfigurationItem = Class( TObject )
       Name : String;

       Constructor Create( const aName : String );
       Function StringRepresentation : String; virtual;
       Procedure SetValue( const aValueRepresentation : String ); virtual; abstract;
     End;

Type CDataConfigurationItem = Class( CConfigurationItem )
       Data : Pointer;
       Constructor Create( const aName : String; var aValue );
     End;

Type CBooleanConfigurationItem = Class( CDataConfigurationItem )
       Constructor Create( const aName : String; var aValue : Boolean );
       Function StringRepresentation : String; override;
       Procedure SetValue( const aValueRepresentation : String ); override;
     End;

Type CIntegerConfigurationItem = Class( CDataConfigurationItem )
       Constructor Create( const aName : String; var aValue : Integer );
       Function StringRepresentation : String; override;
       Procedure SetValue( const aValueRepresentation : String ); override;
     End;

Type CStringConfigurationItem = Class( CDataConfigurationItem )
       Constructor Create( const aName : String; var aValue : String );
       Function StringRepresentation : String; override;
       Procedure SetValue( const aValueRepresentation : String ); override;
     End;

Type TPropertySetProc = Procedure( aValue : Pointer ) of Object;
     TPropertyGetFunc = Function : Pointer of Object;

Type CPropertyConfigurationItem = Class( CConfigurationItem )
       fGet : TPropertyGetFunc;
       fSet : TPropertySetProc;

       Constructor Create( const aName : String; aGetFunc : TPropertyGetFunc; aSetProc : TPropertySetProc );
     End;

Type CIntegerPropertyConfigurationItem = Class( CPropertyConfigurationItem )
       Procedure SetValue( const aValueRepresentation : String ); override;
       Function StringRepresentation : String; override;
     End;

Type CBytePropertyConfigurationItem = Class( CPropertyConfigurationItem )
       Procedure SetValue( const aValueRepresentation : String ); override;
       Function StringRepresentation : String; override;
     End;

Type CFontPropertyConfigurationItem = Class( CPropertyConfigurationItem )
       Procedure SetValue( const aValueRepresentation : String ); override;
       Function StringRepresentation : String; override;
     End;

Type CColorPropertyConfigurationItem = Class( CPropertyConfigurationItem )
       Procedure SetValue( const aValueRepresentation : String ); override;
       Function StringRepresentation : String; override;
     End;

Type CConfiguration = Class( TObject )
       GroupName : String;
       Items : TList;
       Children : TList;

       Constructor Create( const aGroupName : String );
       Destructor Destroy; override;

       (* Load/store a complete configuration *)
       Procedure Store( aParent : CConfiguration; aData : Pointer ); virtual; abstract;
       Procedure Load( aParent : CConfiguration; aData : Pointer ); virtual; abstract;

       Procedure Add( aConfigurationItem : CConfigurationItem  );
       Procedure AddChild( aConfiguration : CConfiguration );
     End;

Type CINIConfiguration = Class( CConfiguration )
       Filename : String;
       Constructor Create( const aGroupName : String; const aFilename : String );
       Procedure Store( aParent : CConfiguration; aData : Pointer ); override;
       Procedure Load( aParent : CConfiguration; aData : Pointer ); override;
     End;

implementation

Function ParseNumber( const S : String ) : Integer;
Var Dummy : Integer;
Begin
  Val( S, Result, Dummy );
End;

Function SplitLine( aString : String; aDelimiter : Char ) : TStringList;
Var I : Integer;
Begin
  Result := TStringList.Create;
  I := Pos( aDelimiter, aString );
  While I > 0 do
    Begin
      Result.Add( Copy( aString, 1, I-1 ));
      aString := Copy( aString, I+1, 255 );
      I := Pos( aDelimiter, aString );
    End;
  Result.Add( aString );
End;

Constructor CConfigurationItem.Create;
Begin
  inherited Create;
  Name := aName;
End;

Function CConfigurationItem.StringRepresentation;
Begin
  StringRepresentation := '';
End;

Constructor CConfiguration.Create;
Begin
  inherited Create;
  Items := TList.Create;
  Children := TList.Create;
  GroupName := aGroupName;
End;

Destructor CConfiguration.Destroy;
  Procedure FreeTListItems( aTList : TList );
  Var I : Integer;
  Begin
    For I := 0 to Pred( aTList.Count ) do
      If Assigned( aTList[ I ] )
        then TObject( aTList[ I ] ).Free;
  End;
Begin
  If Assigned( Items )
    then
      Begin
        FreeTListItems( Items );
        Items.Free;
      End;
  If Assigned( Children )
    then
      Begin
        FreeTListItems( Children );
        Children.Free;
      End;
  inherited Destroy;
End;

Procedure CConfiguration.Add;
Begin
  Items.Add( aConfigurationItem );
End;

Procedure CConfiguration.AddChild;
Begin
  Children.Add( aConfiguration );
End;

Constructor CINIConfiguration.Create;
Begin
  inherited Create( aGroupName );
  Filename := aFilename;
End;

Procedure CINIConfiguration.Store;
Var INIFile : TINIFile;
    I : Integer;
    INIGroupName : String;
Begin
  If aParent = nil
    then
      Begin
        INIFile := TINIFile.Create( Filename );
        INIGroupName := GroupName;
      End
    else
      Begin
        INIFile := aData;
        INIGroupName := (aParent as CINIConfiguration).GroupName + '.' + GroupName;
      End;

  try
    For I := 0 to Pred( Items.Count ) do
      With CConfigurationItem( Items[I] ) do
        INIFile.WriteString( INIGroupName, Name, StringRepresentation );

    For I := 0 to Pred( Children.Count ) do
      CConfiguration( Children[I] ).Store( Self, INIFile );

  finally
    If aParent = nil
      then INIFile.Free;
  end;
End;

Procedure CINIConfiguration.Load;
Var INIFile : TINIFile;
    I : Integer;
    INIGroupName : String;
Begin
  If aParent = nil
    then
      Begin
        INIFile := TINIFile.Create( Filename );
        INIGroupName := GroupName;
      End
    else
      Begin
        INIFile := aData;
        INIGroupName := (aParent as CINIConfiguration).GroupName + '.' + GroupName;
      End;

  try
    For I := 0 to Pred( Items.Count ) do
      With CConfigurationItem( Items[I] ) do
        SetValue( INIFile.ReadString( INIGroupName, Name, ''));

    For I := 0 to Pred( Children.Count ) do
      CConfiguration( Children[I] ).Load( Self, INIFile );

  finally
    If aParent = nil
      then INIFile.Free;
  end;
End;

Constructor CDataConfigurationItem.Create;
Begin
  inherited Create( aName );
  Data := @aValue;
End;

Constructor CBooleanConfigurationItem.Create;
Begin
  inherited Create( aName, aValue );
End;

Function CBooleanConfigurationItem.StringRepresentation;
Begin
  If Boolean( Data^ )
    then StringRepresentation := '1'
    else StringRepresentation := '0';
End;

Procedure CBooleanConfigurationItem.SetValue;
Begin
  Boolean( Data^ ) := (aValueRepresentation = '1');
End;

Constructor CIntegerConfigurationItem.Create;
Begin
  inherited Create( aName, aValue );
End;

Function CIntegerConfigurationItem.StringRepresentation;
Begin
  StringRepresentation := IntToStr( Integer( Data^ ));
End;

Procedure CIntegerConfigurationItem.SetValue;
Begin
  Integer( Data^ ) := ParseNumber( aValueRepresentation );
End;

Constructor CStringConfigurationItem.Create;
Begin
  inherited Create( aName, aValue );
End;

Function CStringConfigurationItem.StringRepresentation;
Var Value : String;
Begin
  Value := String( Data^ );
  StringRepresentation := Value;
End;

Procedure CStringConfigurationItem.SetValue;
Var Value : String;
Begin
  Value := aValueRepresentation;
  String( Data^ ) := Value;
End;

Constructor CPropertyConfigurationItem.Create;
Begin
  inherited Create( aName );
  fGet := aGetFunc;
  fSet := aSetProc;
End;

Function FontStyle( aFont : TFont ) : String;
  Procedure CheckStyle( aStyle : TFontStyle; aChar : Char );
  Begin
    If aStyle in aFont.Style
      then Result := Result + Upcase( aChar )
      else Result := Result + aChar;
  End;
Begin
  Result := '';
  CheckStyle( fsBold, 'b' );
  CheckStyle( fsItalic, 'i' );
  CheckStyle( fsUnderline, 'u' );
  CheckStyle( fsStrikeout, 's' );
End;

Procedure DecodeFontStyle( aFont : TFont; const aValues : String );
Var NewStyle : TFontStyles;
  Procedure CheckStyle( aStyle : TFontStyle; aChar : Char );
  Begin
    If aChar in ['A'..'Z']
      then Include( NewStyle, aStyle );
  End;
Begin
  If Length( aValues ) = 4
    then
      Begin
        NewStyle := [];
        CheckStyle( fsBold, aValues[1] );
        CheckStyle( fsItalic, aValues[2] );
        CheckStyle( fsUnderline, aValues[3] );
        CheckStyle( fsStrikeout, aValues[4] );
        aFont.Style := NewStyle;
      End;
End;

Function CIntegerPropertyConfigurationItem.StringRepresentation;
Var Value : Integer;
Begin
  Value := Integer( fGet^ );
  StringRepresentation := IntToStr( Value );
End;

Procedure CIntegerPropertyConfigurationItem.SetValue;
Var Value : Integer;
Begin
  Value := ParseNumber( aValueRepresentation );
  fSet( @Value );
End;

Function CBytePropertyConfigurationItem.StringRepresentation;
Var Value : Byte;
Begin
  Value := Byte( fGet^ );
  StringRepresentation := IntToStr( Value );
End;

Procedure CBytePropertyConfigurationItem.SetValue;
Var Value : Byte;
Begin
  Value := ParseNumber( aValueRepresentation );
  fSet( @Value );
End;

Function CFontPropertyConfigurationItem.StringRepresentation;
Var Font : TFont;
Begin
  Font := fGet;
  StringRepresentation := '"' + Font.Name + '",' + IntToStr( Font.Size ) + ',' + IntToHex( Font.Color,8 ) + ',' + FontStyle( Font );
End;

Procedure CFontPropertyConfigurationItem.SetValue;
Var Font : TFont;
    Items : TStringList;
Begin
  Font := TFont.Create;

  Items := SplitLine( aValueRepresentation, ',' );
  try
    With Font do
      Begin
        If Items.Count = 4
          then
            Begin
              If Items[0][1] = '"'
                then Items[0] := Copy( Items[0],2,Length( Items[0] )-2 );
              Name := Items[0];
              Size := ParseNumber( Items[1] );
              Color := TColor( ParseNumber( '$'+Items[2] ));
              DecodeFontStyle( Font, Items[3] );
            End;
      End;
    fSet( Font );
  finally
    Items.Free;
  end;
End;

Function CColorPropertyConfigurationItem.StringRepresentation;
Var Value : ^TColor;
Begin
  Value := fGet;
  StringRepresentation := IntToHex( Value^, 8 );
End;

Procedure CColorPropertyConfigurationItem.SetValue;
Var Dummy : Integer;
    Value : TColor;
Begin
  Val( '$'+aValueRepresentation, Value, Dummy );
  fSet( @Value );
End;

end.
